Attribute VB_Name = "mdlParse"
Option Explicit

Public budCount As Integer
Public MessageWindows As Integer

Public nForm() As frmMessage
Private nMessage As RecieveMessage

Public savedMessages() As String

Private ParsingMessage As Boolean

Public FoundForm As Integer

Public Caps As String

Sub sendMessage(message As String, Window As Integer)
    ' >>> MSG 4 U 91\r\n
    'MIME-Version: 1.0\r\n
    'Content-Type: text/x-msmsgscontrol\r\n
    'TypingUser:     alice@ passport.com \ r \ n

    '>>> MSG 5 N 138\r\n
    'MIME-Version: 1.0\r\n
    'Content-Type: text/plain; charset=UTF-8\r\n
    'X-MMS-IM-Format: FN=MS%20Sans%20Serif; EF=; CO=0; CS=0; PF=0\r\n
    '\r\n
    'Are you there?
    
    Dim bMess As String
    bMess = _
    "MIME-Version: 1.0" & vbCrLf & _
    "Content-Type: text/plain; charset=UTF-8" & vbCrLf & _
    "X-MMS-IM-Format: FN=MS%20Sans%20Serif; EF=; CO=0; CS=0; PF=0" & vbCrLf & _
    "" & vbCrLf & _
    message
    
    If Len(message) > 0 Then
        nForm(Window).sckMessage.SendData "MSG " & nForm(Window).trID() & " U " & Len(bMess) & vbCrLf & bMess
    
        nForm(Window).rtfLog.Locked = False
        nForm(Window).rtfLog.SelStart = Len(nForm(Window).rtfLog.Text)
        nForm(Window).rtfLog.SelIndent = 0
        nForm(Window).rtfLog.SelText = frmMain.lblName & " says at " & Time & ":" & vbCrLf
        'nForm(Window).rtfLog.SelFontName = FontName
        'nForm(Window).rtfLog.SelBold = FontBold
        'nForm(Window).rtfLog.SelItalic = FontItalic
        'nForm(Window).rtfLog.SelStrikeThru = FontStrikethru
        'nForm(Window).rtfLog.SelUnderline = FontUnderline
        'nForm(Window).rtfLog.SelColor = FontColor
        nForm(Window).rtfLog.SelIndent = 200
        nForm(Window).rtfLog.SelText = message & vbCrLf
        nForm(Window).rtfLog.Locked = True
    End If
    
End Sub

Sub ParseMessage(message As RecieveMessage, Window As Integer)
          
    Dim prsLines() As String
    Dim prsLine
    Dim prsVar() As String
    Dim prsMnr() As String
    Dim prsMnra
    Dim prsVart() As String
    
    Dim FontName As String
    Dim FontColor As Long
    Dim FontBold As Boolean
    Dim FontItalic As Boolean
    Dim FontStrikethru As Boolean
    Dim FontUnderline As Boolean
    
    Dim MessageBegins As Boolean
    
    prsLines = Split(message.Content, vbCrLf)
    
    For Each prsLine In prsLines
        If Len(prsLine) > 0 Then
        
            Log prsLine
        
            If MessageBegins = True Then
                message.Content = message.Content & prsLine
            End If
        
            prsVar = Split(CStr(prsLine), ": ")
            If prsVar(0) = "TypingUser" Then
                message.Content = ""
                nForm(Window).sbPanel.Panels(1).Text = prsVar(1) & " is typing a message..."
                nForm(Window).tmTyping.Enabled = True
            End If
            If prsVar(0) = "X-MMS-IM-Format" Then
                prsMnr = Split(prsVar(1), "; ")
                Log prsVar(1)
                For Each prsMnra In prsMnr
                    prsVart = Split(CStr(prsMnra), "=")
                    
                    If prsVart(0) = "FN" Then
                        FontName = Urldecode(prsVart(1))
                    End If
                    If prsVart(0) = "EF" Then
                        If InStr(prsVart(1), "B") Then FontBold = True
                        If InStr(prsVart(1), "I") Then FontItalic = True
                        If InStr(prsVart(1), "S") Then FontStrikethru = True
                        If InStr(prsVart(1), "U") Then FontUnderline = True
                    End If
                    If prsVart(0) = "CO" Then
                        FontColor = HexToDecColor(StrReverse(prsVart(1)))
                    End If
                Next
                
                MessageBegins = True
                message.Content = ""
            End If
            
        End If
    Next
    
    If Len(nMessage.Content) > 0 Then
        nForm(Window).rtfLog.Locked = False
        nForm(Window).rtfLog.SelStart = Len(nForm(Window).rtfLog.Text)
        nForm(Window).rtfLog.SelIndent = 0
        nForm(Window).rtfLog.SelText = message.ContactName & " says at " & Time & ":" & vbCrLf
        nForm(Window).rtfLog.SelFontName = FontName
        nForm(Window).rtfLog.SelBold = FontBold
        nForm(Window).rtfLog.SelItalic = FontItalic
        nForm(Window).rtfLog.SelStrikeThru = FontStrikethru
        nForm(Window).rtfLog.SelUnderline = FontUnderline
        nForm(Window).rtfLog.SelColor = FontColor
        nForm(Window).rtfLog.SelIndent = 200
        nForm(Window).rtfLog.SelText = message.Content & vbCrLf
        nForm(Window).rtfLog.Locked = True
    End If
    
End Sub

Sub CParse(Str, Optional Window As Integer)
    On Error GoTo Logit
    
    Dim prsWords() As String
    prsWords = Split(CStr(Str), " ")
    
    If prsWords(0) = "MSG" Then
        nMessage.ContactEmail = prsWords(1)
        nMessage.ContactName = Urldecode(prsWords(2))
        nMessage.Length = CInt(Split(prsWords(3), vbCrLf)(0))
        nMessage.Content = Mid(Str, InStr(Str, vbCrLf) + 2, nMessage.Length)
        
        ParseMessage nMessage, Window
        Exit Sub
    End If
    
    If prsWords(0) = "USR" Then
        nForm(Window).Send "CAL " & nForm(Window).trID() & " " & nForm(Window).ContactEmail
    End If
    
    If prsWords(0) = "JOI" Then
        nForm(Window).rtfLog.SelStart = Len(nForm(Window).rtfLog.Text)
        nForm(Window).rtfLog.SelIndent = 0
        nForm(Window).rtfLog.SelText = Urldecode(CStr(Split(prsWords(2), vbCrLf)(0))) & " (" & prsWords(1) & ") has joined the conversation" & vbCrLf
        nForm(Window).Participants = True
        If UBound(savedMessages) > 0 Then
            Dim i As Integer
            Dim message As String
            For i = 0 To UBound(savedMessages)
                message = savedMessages(i)
                If Len(message) > 0 Then
                    If Split(message, ":/:/:::r0binrules://")(0) = Window Then
                        sendMessage CStr(Split(message, ":/:/:::r0binrules://")(1)), Window
                        savedMessages(i) = ""
                    End If
                End If
            Next
        End If
    End If
    
    If prsWords(0) = "BYE" Then
        nForm(Window).rtfLog.SelStart = Len(nForm(Window).rtfLog.Text)
        nForm(Window).rtfLog.SelIndent = 0
        nForm(Window).rtfLog.SelText = "User has closed the conversation window" & vbCrLf
        nForm(Window).Participants = False
    End If
    
Logit:
    If Err.Number > 0 Then Log Err.Description
End Sub

Sub Parse(Str)

    On Error GoTo Logit
    
    Dim prsLines() As String
    Dim prsLine
    prsLines = Split(Str, vbCrLf)
    
    For Each prsLine In prsLines
    
        If Len(CStr(prsLine)) > 2 Then
        
            Dim prsWords() As String
            prsWords = Split(CStr(prsLine), " ")
                   
            If message.Recieving = True Then
                message.Content = message.Content & CStr(prsLine) & vbCrLf
                message.Length = message.Length - Len(CStr(prsLine) & vbCrLf)
                If message.Length <= 2 Then
                    Log message.Content
                    
                    Dim controla
                    For Each controla In frmMain.Controls
                        If controla.Tag = "x" Then
                            controla.Enabled = True
                        End If
                    Next
                    
                    Send_Command "SYN " & trID() & " 0"
                    frmMain.Height = 5775
                    
                    message.Recieving = False
                    message.Content = ""
                    message.Length = 0
                End If
            Else
                Log "In:  " & CStr(prsLine)
                
                If prsWords(0) = "VER" Then
                    Send_Command "CVR " & trID() & " 0x0409 win 4.10 i386 MSNMSGR 7.0.0816 MSMSGS " & frmMain.txtUsername
                End If
                
                If prsWords(0) = "CVR" Then
                    Send_Command "USR " & trID() & " TWN I " & frmMain.txtUsername
                End If
                
                If prsWords(0) = "XFR" Then
                    If prsWords(2) = "NS" Then
                        frmMain.sckMain.Close
                        Log "Disconnected"
                        frmMain.sckMain.Connect Split(prsWords(3), ":")(0), Split(prsWords(3), ":")(1)
                    ElseIf prsWords(2) = "SB" Then
                    
                        nForm(FoundForm).SessionID = -1
                        nForm(FoundForm).RemoteHost = Split(prsWords(3), ":")(0)
                        nForm(FoundForm).RemotePort = Split(prsWords(3), ":")(1)
                        nForm(FoundForm).AuthString = prsWords(5)
                        
                        Load nForm(FoundForm)
                        nForm(FoundForm).Show
                    
                    End If
                End If
                
                If prsWords(0) = "USR" Then
                
                    If prsWords(2) = "TWN" Then
                        frmMain.inetLogin.Execute nexusURL, "GET", "", _
                        "Authorization: Passport1.4 OrgVerb=GET,OrgURL=http%3A%2F%2Fmessenger%2Emsn%2Ecom,sign-in=" & Urlencode(frmMain.txtUsername.Text) & ",pwd=" & frmMain.txtPassword & "," & prsWords(4) & vbCrLf & _
                        "Host: login.passport.com" & vbCrLf
                    End If
                    
                    If prsWords(2) = "OK" Then
                        frmMain.lblName = prsWords(4)
                        Log "Login Success!"
                    End If
                    
                End If
                
                If prsWords(0) = "MSG" Then
                
                    If prsWords(1) = "Hotmail" And prsWords(2) = "Hotmail" Then
                        message.Length = prsWords(3)
                        message.Recieving = True
                    End If
                    
                End If
                
                If prsWords(0) = "SYN" Then
                    List.totalGroups = prsWords(4)
                    List.totalBuddies = prsWords(3)
                    
                    ReDim List.Groups(List.totalGroups)
                    ReDim List.Buddies(List.totalBuddies)
                End If
                
                If prsWords(0) = "LSG" Then
                    List.Groups(prsWords(1)) = prsWords(2)
                End If
                
                If prsWords(0) = "LST" Then
                
                    With List.Buddies(budCount)
                        frmMain.ContactList1.Add Urldecode(prsWords(2)), prsWords(1), "FLN", "0"
                        .Email = prsWords(1)
                        .FriendlyName = Urldecode(prsWords(2))
                        .Status = "FLN"
                        If UBound(prsWords) >= 4 Then
                            .Group = prsWords(4)
                        Else
                            Log Urldecode(prsWords(2)) & " (" & prsWords(1) & ") has added you to their Friends list!"
                            Log "Automatically adding..."
                            
                            Send_Command "ADD " & trID() & " AL " & prsWords(1) & " " & prsWords(1)
                            Send_Command "ADD " & trID() & " FL " & prsWords(1) & " " & prsWords(1)
                        End If
                    End With
                    
                    budCount = budCount + 1
                    
                    Caps = CStr(4 + 32 + 268435456)
                    
                    If budCount = UBound(List.Buddies) Then
                        Send_Command "CHG " & trID() & " NLN " & Caps
                    End If
                    
                End If
                
                If prsWords(0) = "ILN" Then
                    
                    List.Buddies(GetBuddyByEmail(prsWords(3))).Status = prsWords(2)
                    List.Buddies(GetBuddyByEmail(prsWords(3))).FriendlyName = Urldecode(prsWords(4))
                    UpdateList
                    
                End If
                
                If prsWords(0) = "CHL" Then
                    Dim ToSend As String
                    
                    ToSend = "QRY " & trID() & " msmsgs@msnmsgr.com 32" & vbCrLf
                    ToSend = ToSend & DigestStrToHexStr(prsWords(2) & "Q1P7W2E4J9R8U3S5")
                    
                    frmMain.sckMain.SendData ToSend
                End If
                
                If prsWords(0) = "NLN" Then
                    
                    List.Buddies(GetBuddyByEmail(prsWords(2))).Status = prsWords(1)
                    List.Buddies(GetBuddyByEmail(prsWords(2))).FriendlyName = Urldecode(prsWords(3))
                    UpdateList
                    
                End If
                
                If prsWords(0) = "FLN" Then
                    
                    List.Buddies(GetBuddyByEmail(prsWords(1))).Status = prsWords(0)
                    UpdateList
                    
                End If
                
                If prsWords(0) = "REM" Then
                    If prsWords(2) = "RL" Then
                        Log prsWords(4) & " has removed you from their buddy list! Removing.."
                        Send_Command "REM " & trID() & " AL " & prsWords(4)
                        Send_Command "REM " & trID() & " FL " & prsWords(4)
                    End If
                End If
                
                If prsWords(0) = "ADD" Then
                    
                    If prsWords(2) = "RL" Then
                    
                        Log Urldecode(prsWords(5)) & " (" & prsWords(4) & ") has added you to their Friends list!"
                        Log "Automatically adding..."
                        
                        Send_Command "ADD " & trID() & " AL " & prsWords(4) & " " & prsWords(4)
                        Send_Command "ADD " & trID() & " FL " & prsWords(4) & " " & prsWords(4)
                        
                        List.totalBuddies = List.totalBuddies + 1
                        List.Buddies(List.totalBuddies).Email = prsWords(4)
                        List.Buddies(List.totalBuddies).FriendlyName = Urlencode(prsWords(5))
                        List.Buddies(List.totalBuddies).Group = 0
                        
                    End If
                    
                End If
                               
                If prsWords(0) = "RNG" Then
                    Dim i As Integer
                    For i = 1 To MessageWindows
                        If nForm(i).ContactEmail = prsWords(5) Then
                            
                            nForm(i).SessionID = prsWords(1)
                            nForm(i).RemoteHost = Split(prsWords(2), ":")(0)
                            nForm(i).RemotePort = Split(prsWords(2), ":")(1)
                            nForm(i).AuthString = prsWords(4)
                            nForm(i).ContactEmail = prsWords(5)
                            nForm(i).ContactName = Urldecode(prsWords(6))
                            nForm(i).WindowID = MessageWindows
                            
                            Load nForm(MessageWindows)
                            nForm(MessageWindows).Show
                            
                            nForm(MessageWindows).Connect
                            
                            Exit Sub
                            
                        End If
                    Next
                    
                    MessageWindows = MessageWindows + 1
                    ReDim Preserve nForm(MessageWindows)
                    Set nForm(MessageWindows) = New frmMessage
                    
                        nForm(MessageWindows).SessionID = prsWords(1)
                        nForm(MessageWindows).RemoteHost = Split(prsWords(2), ":")(0)
                        nForm(MessageWindows).RemotePort = Split(prsWords(2), ":")(1)
                        nForm(MessageWindows).AuthString = prsWords(4)
                        nForm(MessageWindows).ContactEmail = prsWords(5)
                        nForm(MessageWindows).ContactName = Urldecode(prsWords(6))
                        nForm(MessageWindows).WindowID = MessageWindows
                    
                    Load nForm(MessageWindows)
                    nForm(MessageWindows).Show
                                    
                End If
                
            End If
        
        End If
    
    Next
    
Logit:
    If Err.Number > 0 Then Log Err.Description
End Sub
